home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / dkbuts.zip / SHELLGEN.BAS < prev    next >
BASIC Source File  |  1991-05-16  |  13KB  |  452 lines
  1. '-----------------------------------------------------------------------------
  2. ' Program : SHELLGEN.BAS (QB 3)
  3. ' Function : Generates a basic script file for DKB Ray Tracer
  4. '            consisting of series of spheres arranged in a logarithmic
  5. '            spiral.  The guts of the code (subroutine SHELLGEN) was converted
  6. '            from C source code from Clifford Pickover's book "Computers,
  7. '            Pattern, Chaos, and Beauty" (St. Martin's Press) and was
  8. '            reprinted in Ray Tracing News, Vol. 3, No. 3.
  9. '
  10. ' Updated to DKB 2.11 by Aaron A. Collins on 5/1/91 - fixed write of a blanked
  11. ' out (unintentional, I'm sure...) SPHERE at the end of the list...
  12. '-----------------------------------------------------------------------------
  13.  
  14. FALSE = 0: TRUE = NOT FALSE
  15.  
  16. COLS=640 : ROWS = 350
  17. XCENTER = COLS/2 : YCENTER = ROWS/2
  18.  
  19. '          ---  FORMAT A NUMERIC STRING
  20. DEF FNFMT$ (A#)
  21.     FORM$="-####.######"
  22.     STATIC SIGN, S$, P, A$, DEC, W$, F$, WF$, FF$, PAD$, ADD$
  23. '
  24.     SIGN = SGN(A#)
  25.     A# = ABS(A#)
  26.  
  27. '          ---  SEPARATE WHOLE AND FRACTIONAL PARTS OF NUMBER
  28.     W$ = MID$(STR$(INT(A#)), 2)
  29.     IF W$ = "" THEN W$ = "0"
  30.     S$ = STR$(1 + A#)
  31.     P = INSTR(S$, ".")
  32.     IF P = 0 THEN
  33.         F$ = ""
  34.        ELSE F$ = MID$(S$, P + 1)
  35.     END IF
  36.  
  37. '          ---  SEPARATE WHOLE AND FRACTION FORMAT STRINGS
  38.     DEC = INSTR(FORM$, ".")
  39.     IF DEC = 0 THEN
  40.         WF$ = FORM$: FF$ = ""
  41.        ELSE WF$ = LEFT$(FORM$, DEC - 1)
  42.         FF$ = MID$(FORM$, DEC + 1)
  43.     END IF
  44.  
  45.     ADD$ = "": PAD$ = " "
  46.  
  47. '          ---  ADD SIGN CHARACTER
  48.     IF LEFT$(WF$, 1) = "-" THEN
  49.         WF$ = MID$(WF$, 2)
  50.         IF SIGN = -1 THEN
  51.             ADD$ = ADD$ + "-"
  52.            ELSE ADD$ = ADD$ + " "
  53.         END IF
  54.     END IF
  55.     
  56. '          ---  HANDLE NUMERIC OVERFLOW AND UNDERFLOW
  57.     IF LEN(W$) > LEN(WF$) THEN W$ = "%" + RIGHT$(W$, LEN(WF$) - 1)
  58.     IF LEN(F$) > LEN(FF$) THEN F$ = LEFT$(F$, LEN(FF$))
  59. '          ---  FORMAT THE NUMBER STRING
  60.     IF DEC > 0 THEN W$ = W$ + "." + F$ + STRING$(LEN(FF$) - LEN(F$), "0")
  61.     FNFMT$ = ADD$ + W$
  62. END DEF
  63.  
  64. DEF FNMIN(A, B)
  65.     IF B < A THEN FNMIN= B ELSE FNMIN = A
  66. END DEF
  67. DEF FNMAX(A, B)
  68.     IF B > A THEN FNMAX= B ELSE FNMAX = A
  69. END DEF
  70.  
  71. '---------------------------
  72. '   ---
  73. '   --- Some constants and default variables
  74. '   ---
  75. PAINTFLAG       =  FALSE
  76. PI              =  3.1415
  77. DEF.FORMULA     =  1
  78. DEF.ORIENTATION =  1
  79. DEF.GAMMA       =  1.0
  80. DEF.ALPHA       =  1.1
  81. DEF.BETA        =  2.0
  82. DEF.STEPS       =  600
  83. DEF.EXPONENT    =  0.15
  84. DEF.MAG         =  1
  85. DEF.VIEWER      =  150   ' DISTANCE FROM VIEWER TO SCREEN PLANE (Z0)
  86. MAG.ADJUST      =  0.125
  87.  
  88. FORMULA     =  DEF.FORMULA
  89. ORIENTATION =  DEF.ORIENTATION
  90. GAMMA       =  DEF.GAMMA
  91. ALPHA       =  DEF.ALPHA
  92. BETA        =  DEF.BETA
  93. STEPS       =  DEF.STEPS
  94. EXPONENT    =  DEF.EXPONENT
  95. VIEWER      =  DEF.VEWIER
  96. MAG         =  DEF.MAG
  97.  
  98. ORG.FORMULA$     =  "Original formula used was 1."
  99. ORG.ORIENTATION$ =  "Original value used was 1."
  100. ORG.GAMMA$       =  "Try 0.01 to 3. Default was 1.  Affects ratio of largest to smallest."
  101. ORG.ALPHA$       =  "Value greater than 1 is advised.  Used in calculating Z."
  102. ORG.BETA$        =  "Stay somewhere near -2.0 to 2.0.  Used in calculating Z."
  103. ORG.STEPS$       =  "Default value was 600 steps."
  104. ORG.EXPONENT$    =  "0.15 (Stay pretty close).  Affects radius."
  105. ORG.MAG$         =  "1    Scale the overall image size."
  106. ORG.VIEWER$      =  "150  Larger values are similar to using a telephoto lens."
  107.  
  108. DO
  109.     CLS
  110.     GOSUB GET.PARMS
  111.     GOSUB SHELLGEN
  112.     GOSUB SORT.QUEUE
  113.     GOSUB DISPLAY
  114.     CALL CLEARKBUFF
  115.     WHAT.TO.DO$=""
  116.     LOCATE 1,1 : PRINT " [S]ave   [M]ore   [P]aint  [Q]uit    ";
  117.     LINE INPUT WHAT.TO.DO$
  118.     IF WHAT.TO.DO$ = "" THEN WHAT.TO.DO$="M"
  119.     IF INSTR("Ss",WHAT.TO.DO$) >0 THEN
  120.         GOSUB WRITE.FILE
  121.     ELSEIF INSTR("Qq",WHAT.TO.DO$) > 0 THEN
  122.         EXIT DO
  123.     ELSEIF INSTR("Pp",WHAT.TO.DO$) > 0 THEN
  124.         PAINTFLAG = TRUE
  125.         GOSUB DISPLAY
  126.         PAINTFLAG = FALSE
  127.         CALL CLEARLINE("1")
  128.         LOCATE 1,1: PRINT "Press any key to continue ...";
  129.         CALL WAITKEY
  130.     END IF
  131.     SCREEN 0: WIDTH 80
  132. LOOP WHILE TRUE                             ' GET.PARMS QUITS IF FORMULA=3
  133.  
  134. SCREEN 0 :WIDTH 80: CLS
  135. SYSTEM
  136.  
  137. '
  138. '   --- Generate the X, Y, Z, and radius for the image and store data
  139. '       in a buffer for later sorting and drawing.
  140. SHELLGEN:
  141.     LOCATE 25, 1: PRINT "Generating...";
  142.  
  143.     LOW = -STEPS*2/3 :HI = STEPS/3
  144.     NDATA = ABS(LOW) + HI
  145.  
  146.     '   --- QUEUE array : 1 == X, 2 == Y, 3 == X,
  147.     '                     4 == Adjusted Radius, 5 == Real Radius
  148.     '   --- INDEX array will contain sorted pointers to Z element of QUEUE.
  149.     REDIM QUEUE(NDATA, 5) : REDIM INDEX(NDATA)
  150.     '   --- INIT BOUNDING DIMENSIONS
  151.     MIN.X = 0: MAX.X = 0 : MIN.Y=0 : MAX.Y = 0 : MIN.Z = 0 : MAX.Z = 0
  152.  
  153.  
  154.     COUNTER = 0
  155.     FOR I = LOW TO HI                     ' AAC - WAS HI - 1
  156.         COUNTER = COUNTER+1
  157.         INDEX(COUNTER) = COUNTER         ' INITIALIZE SORT ARRAY
  158.         ANGLE = 3! * 6! * PI * I / STEPS
  159.         R = (MAG) * EXP(EXPONENT * ANGLE)
  160.         A$ = FNFMT$(R * SIN(ANGLE))
  161.         B$ = FNFMT$(R * COS(ANGLE))
  162.         IF FORMULA = 1 THEN
  163.             C$ = FNFMT$(BETA * R)
  164.         ELSE
  165.             C$ = FNFMT$(ALPHA * ANGLE)
  166.         END IF
  167.         RAD$ = FNFMT$(R / GAMMA)
  168.         GOSUB ORIENT.XYZ                         ' DETERMINE XY&Z VALUES
  169.         QUEUE(COUNTER ,5) = VAL(RAD$)            ' SAVE UN-ADJUSTED RADIUS
  170.         GOSUB SCALE.RADIUS                       ' SCALE R BASED ON DISTANCE
  171.     QUEUE(COUNTER, 1) = X: QUEUE(COUNTER, 2) = Y
  172.     QUEUE(COUNTER, 3) = Z: QUEUE(COUNTER, 4) = R
  173.         GOSUB MAXBOUNDS
  174.     NEXT I
  175. RETURN
  176.  
  177. '   ---
  178. '   --- Keep track of the smallest and largest XYZs
  179. '   ---
  180. MAXBOUNDS:
  181.     MIN.X = FNMIN(MIN.X, X-R) : MAX.X = FNMAX(MAX.X, X+R)
  182.     MIN.Y = FNMIN(MIN.Y, Y-R) : MAX.Y = FNMAX(MAX.Y, Y+R)
  183.     MIN.Z = FNMIN(MIN.Z, Z-R) : MAX.Z = FNMAX(MAX.Z, Z+R)
  184. RETURN
  185.  
  186.  
  187. '   ---
  188. '   --- Scale radius based upon distance from viewer
  189. '   ---
  190. SCALE.RADIUS:
  191.     R = TAN(ATN(R / ABS(VIEWER - Z))) * VIEWER
  192. RETURN
  193.  
  194. '   ---
  195. '   --- Convert XYZ and Radius formatted strings into values
  196. '   --- Orient the axis in the specified plane
  197. '   ---
  198. ORIENT.XYZ:
  199.     IF ORIENTATION = 1 THEN
  200.         Z = VAL(A$): Y = VAL(B$): X = VAL(C$)    ' Center in X Plane
  201.     ELSEIF ORIENTATION = 2 THEN
  202.         Y = VAL(C$): Z = VAL(B$): X = VAL(A$)    ' Center in Y Plane
  203.     ELSE
  204.         X = VAL(A$): Y = VAL(B$): Z = VAL(C$)    ' Center in Z Plane
  205.     END IF
  206.     R = VAL(RAD$)
  207. RETURN
  208.  
  209. '   ---
  210. '   --- Sort the circles on Z, from most distant to closest for simple
  211. '       "hidden line removal".  Farthest will be drawn first and overlapped
  212. '       by the nearer circles.
  213. '   ---
  214. SORT.QUEUE:
  215.     LOCATE 25, 1: PRINT "Sorting ...  ";
  216.     OFFSET = NDATA
  217.     DO WHILE OFFSET > 1
  218.         OFFSET = INT(OFFSET / 2)
  219.         DO
  220.             INORDER = TRUE
  221.             FOR J = 1 TO (NDATA - OFFSET)
  222.                 I = J + OFFSET
  223.                 IF QUEUE(INDEX(I), 3) > QUEUE(INDEX(J), 3) THEN
  224.                     SWAP INDEX(I), INDEX(J)
  225.                     INORDER = FALSE
  226.                 END IF
  227.             NEXT J
  228.         LOOP UNTIL INORDER
  229.     LOOP     ' While offset > 1
  230.     LOCATE 25, 1: PRINT "             ";
  231. RETURN
  232.  
  233.  
  234. '   ---
  235. '   --- Here is where we draw the image, using sorted index of Z elements
  236. '       to draw most distant circles first.
  237. '   ---
  238. DISPLAY:
  239.     SCREEN 9
  240.     FOR I = 1 TO NDATA
  241.         X = QUEUE(INDEX(I), 1)
  242.         Y = QUEUE(INDEX(I), 2)
  243.         Z = QUEUE(INDEX(I), 3)
  244.         R = QUEUE(INDEX(I), 4)
  245.         KOLOR = ABS(Z) MOD 3 +1
  246.         XPOINT = XCENTER + X: YPOINT = YCENTER + Y
  247.         CIRCLE (XPOINT, YPOINT), R, KOLOR
  248.         IF PAINTFLAG = TRUE THEN
  249.             IF XPOINT >= COLS THEN XPOINT = COLS -1
  250.             IF XPOINT < 1     THEN XPOINT = 1
  251.             IF YPOINT >= ROWS THEN YPOINT = ROWS -1
  252.             IF YPOINT < 1     THEN YPOINT = 1
  253.             PAINT  (XPOINT, YPOINT), KOLOR
  254.         END IF
  255.     NEXT I
  256. RETURN
  257.  
  258. '   ---
  259. '   --- Get user input for various parameters.
  260. '   ---
  261. GET.PARMS:
  262.     CALL SHOW.DEFAULTS (ORG.FORMULA$,DEF.FORMULA)
  263.     PRINT " Formula to use for calculating Z "
  264.     PRINT " 1) [z=beta*r]    2) [z=alpha*angle]    3) QUIT: ";
  265.     INPUT FORMULA
  266.     IF FORMULA = 3 THEN END
  267.  
  268.     CALL SHOW.DEFAULTS (ORG.ORIENTATION$,DEF.ORIENTATION)
  269.     PRINT " Center Axis Orientation "
  270.     PRINT " ( 1=X  2=Y  3=Z ) : ";
  271.     INPUT ORIENTATION
  272.  
  273.     PRINT
  274.     CALL SHOW.DEFAULTS (ORG.GAMMA$,DEF.GAMMA)
  275.     PRINT " Value of GAMMA    : ";
  276.     INPUT GAMMA
  277.  
  278.     CALL SHOW.DEFAULTS (ORG.STEPS$,DEF.STEPS)
  279.     PRINT " Number of steps   : ";
  280.     INPUT STEPS
  281.  
  282.     IF FORMULA = 1 THEN
  283.         CALL SHOW.DEFAULTS(ORG.BETA$,DEF.BETA)
  284.         PRINT " Value of BETA     : ";
  285.         INPUT BETA
  286.     ELSE
  287.         CALL SHOW.DEFAULTS(ORG.ALPHA$,DEF.ALPHA)
  288.         PRINT " Value of ALPHA    : ";
  289.         INPUT ALPHA
  290.     END IF
  291.  
  292.     CALL SHOW.DEFAULTS(ORG.EXPONENT$,DEF.EXPONENT)
  293.     PRINT " Exponential Scale : ";
  294.     INPUT EXPONENT
  295.  
  296.     CALL SHOW.DEFAULTS(ORG.MAG$,DEF.MAG)
  297.     PRINT " Magnification     : ";
  298.     INPUT MAG
  299.  
  300.     CALL SHOW.DEFAULTS(ORG.VIEWER$,DEF.VIEWER)
  301.     PRINT " Viewer Distance   : ";
  302.     INPUT VIEWER
  303.  
  304.     IF ORIENTATION = 0 OR ORIENTATION > 3 THEN ORIENTATION = DEF.ORIENTATION
  305.     IF FORMULA  =  0 THEN FORMULA  = DEF.FORMULA
  306.     IF STEPS    =  0 THEN STEPS    = DEF.STEPS
  307.     IF BETA     =  0 THEN BETA     = DEF.BETA
  308.     IF ALPHA    =  0 THEN ALPHA    = DEF.ALPHA
  309.     IF GAMMA    =  0 THEN GAMMA    = DEF.GAMMA
  310.     IF EXPONENT =  0 THEN EXPONENT = DEF.EXPONENT
  311.     IF VIEWER   <  1 THEN VIEWER   = DEF.VIEWER
  312.     IF MAG      =  0 THEN MAG      = DEF.MAG
  313.  
  314.     DEF.FORMULA =  FORMULA
  315.     DEF.ORIENTATION = ORIENTATION
  316.     DEF.GAMMA    =  GAMMA
  317.     DEF.ALPHA    =  ALPHA
  318.     DEF.BETA     =  BETA
  319.     DEF.STEPS    =  STEPS
  320.     DEF.EXPONENT =  EXPONENT
  321.     DEF.VIEWER   =  VIEWER
  322.     DEF.MAG      =  MAG
  323.     CALL CLEARLINE("24")
  324.     CALL CLEARLINE("25")
  325.  
  326. RETURN
  327.  
  328. WRITE.FILE:
  329.  
  330.     INCLUDE.FILE$="DKBSHELL.INC"
  331.     CALL CLEARLINE("1")
  332.     LOCATE 1,1: PRINT " Name of include file? (Default = "+INCLUDE.FILE$+") : " ;
  333.     LINE INPUT INCLUDE.FILE$
  334.     IF INCLUDE.FILE$="" THEN INCLUDE.FILE$="DKBSHELL.INC"
  335.  
  336.     OUTFILE$="DKBSHELL.DAT"
  337.     CALL CLEARLINE("1")
  338.     LOCATE 1,1: PRINT " Name for generated database? (Default = "+OUTFILE$+") : ";
  339.     LINE INPUT OUTFILE$
  340.     IF OUTFILE$="" THEN OUTFILE$="DKBSHELL.DAT"
  341.     OPEN "O",#1, OUTFILE$
  342.         
  343.     IF INCLUDE.FILE$ <> "" THEN GOSUB WRITE.INCLUDE
  344.     GOSUB WRITE.HEADER
  345.     GOSUB WRITE.BODY
  346.     GOSUB WRITE.FOOTER
  347.     CLOSE #1 : CLOSE #2
  348.  
  349.     CALL CLEARLINE("1")
  350.     LOCATE 1,1: PRINT " Finished.  Press any key...";
  351.     CALL WAITKEY
  352. RETURN
  353.  
  354. WRITE.HEADER:
  355.     PRINT #1, "{"
  356.     PRINT #1, " SHELLGEN generated DKB script for Pickover seashell."
  357.     PRINT #1, ""   
  358.     PRINT #1, " Parameters used : "
  359.     PRINT #1, "     Gamma :";GAMMA
  360.     PRINT #1, "     Steps :";STEPS
  361.     PRINT #1, "     Exponent :";A
  362.     PRINT #1, "     Relative Size :";K
  363.     PRINT #1, "     Number of spheres generated :"; NDATA
  364.     PRINT #1, "     X-bounds = ";MIN.X; " to "; MAX.X
  365.     PRINT #1, "     Y-bounds = ";MIN.Y; " to "; MAX.Y
  366.     PRINT #1, "     Z-bounds = ";MIN.Z; " to "; MAX.Z
  367.     
  368.     IF FORMULA=1 THEN
  369.         PRINT #1, "     Beta  :";BETA
  370.         PRINT #1, "     Z = BETA * R"
  371.     ELSE
  372.         PRINT #1, "     Alpha :";ALPHA
  373.         PRINT #1, "     Z = ALPHA * ANGLE"
  374.     END IF    
  375.  
  376.     PRINT #1, "}"    
  377.     PRINT #1, "{ *** Define the Shell object *** } "
  378.     PRINT #1, "DECLARE Shell = OBJECT"
  379.     PRINT #1, "    UNION"
  380. RETURN
  381.  
  382. WRITE.BODY:
  383.     FOR I = 1 TO NDATA             ' PRINT UNSORTED, STRING-FORMATTED DATA
  384.         X$ = FNFMT$(QUEUE(I, 1))
  385.         Y$ = FNFMT$(QUEUE(I, 2))
  386.         Z$ = FNFMT$(QUEUE(I, 3))
  387.         R$ = FNFMT$(QUEUE(I, 5))   ' UN-ADJUSTED RADIUS
  388.         PRINT #1, "       SPHERE < ";X$;" ";Y$;" ";Z$;" > "; R$; " END_SPHERE"
  389.     NEXT I    
  390. RETURN
  391.  
  392.  
  393. WRITE.FOOTER:
  394.         PRINT #1, "    END_UNION"
  395.         PRINT #1, "    TEXTURE"
  396.         PRINT #1, " {  Edit the following 6 lines to change surface quality   }"
  397.         PRINT #1, "       AMBIENT 0.3"
  398.         PRINT #1, "       DIFFUSE 0.7"
  399.         PRINT #1, "       REFRACTION 1.0 { A little translucency              }"
  400.         PRINT #1, "       IOR 1.0        { without any actual refraction      }"       
  401.         PRINT #1, "       PHONG 1.0      { Might try replacing these next two }"     
  402.         PRINT #1, "       PHONGSIZE 20.0 { with the SPECULAR keyword.         }"
  403.         PRINT #1, "       COLOUR RED 1.0 GREEN 0.498039 BLUE 0.0 ALPHA 0.4 { Coral }"
  404.         PRINT #1, "    END_TEXTURE"  
  405.         PRINT #1, "    COLOUR RED 1.0 GREEN 0.498039 BLUE 0.0 ALPHA 0.4 { Coral }"
  406.         PRINT #1, "END_OBJECT"
  407.         PRINT #1, " "
  408.         PRINT #1, "{   This is where we actually position the shell object.   }"
  409.         PRINT #1, "OBJECT"
  410.         PRINT #1, "    Shell"
  411.         PRINT #1, "    SCALE     < 1.0  1.0  1.0 >"
  412.         PRINT #1, "    ROTATE    < 0.0  0.0  0.0 >"
  413.         PRINT #1, "    TRANSLATE < 0.0  0.0  0.0 >"
  414.         PRINT #1, "END_OBJECT"
  415. RETURN
  416.  
  417. ' Add an include file into the script
  418. WRITE.INCLUDE:
  419.     OPEN "I", #2, INCLUDE.FILE$ 
  420.     WHILE NOT EOF(2)
  421.         LINE INPUT #2,ASTRING$
  422.         PRINT #1, ASTRING$
  423.     WEND
  424. RETURN
  425.  
  426. SUB SHOW.DEFAULTS (ORG.VALUE$, DEF.VALUE) STATIC
  427.     AROW = CSRLIN
  428.     ACOL = POS(0)
  429.     CALL CLEARLINE("24")
  430.     CALL CLEARLINE("25")
  431.     LOCATE 24,4: PRINT ORG.VALUE$;
  432.     LOCATE 25,4: PRINT "Hit <ENTER> to use "; DEF.VALUE;
  433.     LOCATE AROW,ACOL
  434. END SUB
  435.  
  436. SUB CLEARLINE(WHATLINE$) STATIC
  437.     WHATLINE=VAL(WHATLINE$)
  438.     AROW = CSRLIN
  439.     ACOL = POS(0)
  440.     LOCATE WHATLINE,1: PRINT SPACE$(80);
  441.     LOCATE AROW,ACOL
  442. END SUB
  443.  
  444. SUB WAITKEY STATIC
  445.     CALL CLEARKBUFF
  446.     WHILE INKEY$ =  "" : WEND
  447. END SUB
  448.  
  449. SUB CLEARKBUFF STATIC
  450.     WHILE INKEY$ <> "" :WEND
  451. END SUB
  452.